home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVMENU2 / MENUTEST.PAS next >
Pascal/Delphi Source File  |  1992-07-04  |  3KB  |  82 lines

  1. { Purpose: Program to illustrate the use of Tickable menu items.
  2.  
  3.   Compile notes: I have all my standard text for message boxes and dialogs
  4.                  in a resource file that is initialised before object MyApp
  5.                  is initialised.  To compile this program with standard TV
  6.                  units, remove the reference to the Messages unit in the
  7.                  'uses' clause and remove the procedure calls to InitMessages
  8.                  and DoneMessages in the program procedure.
  9.  
  10.   Use freely if you find it useful.
  11.  
  12.   (C) Bill Seddon 1992   CompuServe 100111,557                               }
  13.  
  14. Program MenuTest;
  15.  
  16. uses App, Drivers, Menus, MenuTick, Messages, Objects, Views;
  17.  
  18. const
  19.    cmMenuItem1 = 100;
  20.    cmMenuItem2 = 101;
  21.    cmMenuItem3 = 102;
  22.  
  23. type
  24.    PMyApp = ^TMyApp;
  25.    TMyApp = object( TApplication )
  26.       Procedure HandleEvent( var Event : TEvent ); virtual;
  27.       Procedure InitMenuBar; virtual;
  28.    end;
  29.  
  30. {== TMyApp methods ==========================================================}
  31.  
  32. { Here HandleEvent is used to change the mark on the selected MenuItem (see
  33.   below).  In reality, this will be done in some more meaningful way in the
  34.   HandleEvent (or method called by HandleEvent) of an object that responds to
  35.   particular a particulat command.  Here it just toggles the check mark      }
  36.  
  37. Procedure TMyApp.HandleEvent( var Event : TEvent );
  38. begin
  39.    if ( Event.What = evCommand ) then
  40.    if ( Event.Command in [cmMenuItem1..cmMenuItem3] ) then
  41.    begin
  42.       if MenuItemIsChecked( MenuBar^.Menu, Event.Command ) then
  43.          ClearMenuItem( MenuBar^.Menu, Event.Command ) else
  44.          CheckMenuItem( MenuBar^.Menu, Event.Command );
  45.    end;
  46.  
  47.    TApplication.HandleEvent( Event );
  48. end;
  49.  
  50. { This method builds a menu structure in the same way as usual.  The change
  51.   here is that instead of calling the NewItem function, the MenuTick function
  52.   NewCheckItem is used.  If the Checked parameter is true then the item will
  53.   appear in the menu bar already checked.                                    }
  54.  
  55. Procedure TMyApp.InitMenuBar;
  56. var
  57.    R : TRect;
  58. begin
  59.    GetExtent( R );
  60.    R.B.Y := R.A.Y+1;
  61.    MenuBar := New( PMenuBar, Init( R, NewMenu(
  62.       NewSubMenu( '~T~est', hcNoContext, NewMenu(
  63.       NewCheckItem( 'Menu Item ~1~', 'Alt-A', kbAltA,
  64.                      cmMenuItem1, hcNoContext, False,
  65.       NewCheckItem( 'Menu Item ~2~', 'Alt-B', kbAltB,
  66.                      cmMenuItem2, hcNoContext, False,
  67.       NewCheckItem( 'Menu Item ~3~', 'Alt-C', kbAltC,
  68.                      cmMenuItem3, hcNoContext, True,
  69.                nil ) ) ) ),
  70.       NewItem( 'E~x~it', '', kbNoKey, cmQuit, hcNoContext, nil ) ) ) ) );
  71. end;
  72.  
  73. var
  74.    MyApp : TMyApp;
  75.  
  76. begin
  77.    InitMessages;
  78.    MyApp.Init;
  79.    MyApp.Run;
  80.    MyApp.Done;
  81.    DoneMessages;
  82. end.